home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue50 / HTML / Demo1A.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-11  |  2.9 KB  |  135 lines
  1. {$A+,B-,C+,D+,E-,F-,G+,H+,I+,J+,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1}
  2.  
  3. {$MINSTACKSIZE $00004000}
  4.  
  5. {$MAXSTACKSIZE $00100000}
  6.  
  7. {$IMAGEBASE $00400000}
  8.  
  9. {$APPTYPE GUI}
  10.  
  11. unit Demo1A;
  12.  
  13. interface
  14.  
  15. uses
  16.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  17.   ComCtrls, StdCtrls, usXMLDoc, DBTables;
  18.  
  19. type
  20.   TfrmMain = class(TForm)
  21.     PageControl1: TPageControl;
  22.     TabSheet1: TTabSheet;
  23.     TabSheet2: TTabSheet;
  24.     btnParse: TButton;
  25.     tvDocument: TTreeView;
  26.     Label1: TLabel;
  27.     memSML: TMemo;
  28.     Button1: TButton;
  29.     memOutput: TMemo;
  30.     dbSample: TDatabase;
  31.     procedure btnParseClick(Sender: TObject);
  32.     procedure Button1Click(Sender: TObject);
  33.     procedure FormCreate(Sender: TObject);
  34.   private
  35.   protected
  36.     procedure AddElement(aNode: TTreeNode; aElement: TusXMLElement);
  37.     procedure FillTreeViewFromDocument(aDocument: TusXMLDocument);
  38.     function ResolveSML(aSML: string): string;
  39.   public
  40.   end;
  41.  
  42. var
  43.   frmMain: TfrmMain;
  44.  
  45. implementation
  46.  
  47. uses mleTagResolvers;
  48.  
  49. {$R *.DFM}
  50.  
  51. procedure TfrmMain.btnParseClick(Sender: TObject);
  52. begin
  53.   with TusXMLParser.Create do
  54.     try
  55.       LoadXML('<SML>' + memSML.Lines.Text + '</SML>');
  56.       FillTreeViewFromDocument(Document);
  57.     finally
  58.       Free;
  59.     end;
  60. end;
  61.  
  62. procedure TfrmMain.AddElement(aNode: TTreeNode; aElement: TusXMLElement);
  63. var
  64.   I: Integer;
  65.   Node: TTreeNode;
  66.   AttrNode: TTreeNode;
  67. begin
  68.   with tvDocument.Items do
  69.   begin
  70.     Node := AddChild(aNode, Format('<%s>', [aElement.TagName]));
  71.  
  72.     AttrNode := AddChild(Node, 'Attributes');
  73.     with aElement.Attributes do
  74.       for I := 0 to Count - 1 do
  75.         AddChild(AttrNode, Format('%s = "%s"', [Items[I].Name, Items[I].Value]));
  76.  
  77.     if aElement.Data = '' then
  78.       AddChild(Node, 'Data: (none)')
  79.     else
  80.       AddChild(Node, Format('Data: "%s"', [aElement.Data]));
  81.        
  82.     with aElement.Subtags do
  83.       for I := 0 to Count - 1 do
  84.         AddElement(Node, Items[I]);
  85.   end;
  86. end;
  87.  
  88. procedure TfrmMain.FillTreeViewFromDocument(aDocument: TusXMLDocument);
  89. var
  90.   I: Integer;
  91. begin
  92.   with aDocument do
  93.   begin
  94.     tvDocument.Items.Clear;
  95.     for I := 0 to Count - 1 do
  96.       AddElement(nil, Items[I]);
  97.     with tvDocument do
  98.     begin
  99.       TopItem := Items[0];
  100.       TopItem.Expand(False);
  101.     end;
  102.   end;
  103. end;
  104.  
  105. procedure TfrmMain.Button1Click(Sender: TObject);
  106. begin
  107.   memOutput.Lines.Text := ResolveSML(memSML.Text);
  108. end;
  109.  
  110. function TfrmMain.ResolveSML(aSML: string): string;
  111. begin
  112.   with TusXMLParser.Create do
  113.     try
  114.       LoadXML('<SML>' + aSML + '</SML>');
  115.       ObjectCache.Clear;
  116.       with TSMLTagResolver.Create(nil, Document.Root) do
  117.         try
  118.           Setup;
  119.           Resolve;
  120.           Result := GetHTML;
  121.         finally
  122.           Free;
  123.         end;
  124.     finally
  125.       Free;
  126.     end;
  127. end;
  128.  
  129. procedure TfrmMain.FormCreate(Sender: TObject);
  130. begin
  131.   mleTagResolvers.MLEDatabase := dbSample;
  132. end;
  133.  
  134. end.
  135.